home *** CD-ROM | disk | FTP | other *** search
- { Write part of a file }
-
- uses Txt; {$I+}
-
- { ─────────────── Part ─────────────── }
- procedure Part(Filename1,Filename2:string;Start,Len,Start2:longint);
- var File1,File2:file;
- I,N,Q:longint;
- Buf:pointer;
- begin
- GetMem(Buf,64000);
- Assign(File1,Filename1); Reset(File1,1);
- Assign(File2,Filename2); {$I-} Reset(File2,1); {$I+}
- if IOResult<>0 then Rewrite(File2,1);
- Seek(File1,Start); Seek(File2,Start2);
- N:=64000; Q:=Len div 64000;
- for I:=0 to Q do begin
- if I=Q then N:=Len mod 64000;
- BlockRead(File1,Buf^,N);
- BlockWrite(File2,Buf^,N);
- end;
- Close(File1); Close(File2);
- FreeMem(Buf,64000);
- end;
-
- var A,B,C,L:longint;
- I:integer;
- begin
- Writeln;
- Writeln('Part ─── Write part of a file');
- Writeln('Copyright (C) 1994 by Jou-Nan Chen');
- L:=FileLen(ParamStr(1),1);
- Val(ParamStr(3),A,I); Val(ParamStr(4),B,I); Val(ParamStr(5),C,I);
- if (ParamCount<>5) or (I<>0) or (L<1) or (A<0) or (B<1) or (C<0)
- or (A>L-1) or (B>L-A) then begin
- Writeln;
- Writeln('Usage: Part InputFile OutputFile StartByte Length File2StartByte');
- Halt(1);
- end;
- Part(ParamStr(1),ParamStr(2),A,B,C);
- end.
-